perm filename SUBR4.F4[MUS,LCS]1 blob sn#166861 filedate 1975-07-06 generic text, type T, neo UTF8
00100	C   SUBR4.F4
00200	C  THIS SUBR. ALLOWS RAND. SELECTION FROM UP TO 5 RHYTHMIC STRINGS
00300	C OF UP TO 19 UNITS EACH.  (2OTH UNIT IS END MARK.)
00400	
00500		SUBROUTINE SUBR
00600		COMMON /INS/ INST(27),BG(60)
00700		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00800	C   INUM=INST#  IPAR=PARAM#  
00900	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01000	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
01100	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
01200	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
01300	C   F1=86  F15=100 (NO F16!)
01400	
01500		DIMENSION RH(20,5),Z(5)
01600	C  SETS UP 2-DIMENSIONAL ARRAY FOR RHYTHS.  Z IS FOR STORAGE.
01700	
01800		J=CNT(INUM)
01900		IF(J.NE.1)GO TO 10
02000	
02100		XDUR=DUR(INUM)
02200	C  SAVES ORIGINAL GIVEN DURATION.
02300		DUR(INUM)=1000
02400	C  SO THERE WILL BE ENOUGH ROOM FOR LAST RHYTH. STRING.
02500	
02600		J2=P(2)
02700	C GETS POINTER TO 1ST RHYTH. STRING.
02800	
02900		J3=P(3)
03000	C  GETS BEGIN POINT OF CHROM. SCALE.
03100	
03200		K=0
03300	C INITIALIZE THE COUNTER.
03400	
03500		DO 20 L=1,5
03600	20	Z(L)=0
03700	C  ZERO ALL 'Z' STORAGE.
03800	
03900	10	IF(J.GT.20)GO TO 1
04000	C  THE FIRST 20 NOTES WILL LOAD UP THE RHYTH. STORAGE SLOTS.
04100	
04200		DO 100 L=1,5
04300		IF(Z(L).GT.20)GO TO 100
04400	C  LOOKS AT PREVIOUS VALUE. SKIPS IF IT WAS AN END MARK.
04500	
04600		Z(L)=P(L+10)
04700	C  SAVES VALUES FROM P11→P15
04800	
04900		RH(J,L)=Z(L)
05000	C  PUT IT AWAY 
05100	
05200	100	CONTINUE
05300	
05400	1	K=K+1
05500	C  UPDATE COUNTER
05600	
05700		X=RH(K,J2)
05800	C  PICKS UP RHYTHM NUMBER K.
05900	
06000		IF(X.LT.20)GO TO 2
06100	C  JUMP IF NOT END MARK.  RHYTH VALUE OF .1=40, HENCE END MARK.
06200	
06300		K=1
06400	C  RESET COUNTER
06500	
06600		J2=P(2)
06700	C PICK A NEW POINTER FOR RHYTH. STRINGS.
06800	
06900		J3=P(3)
07000	C  PICK UP NEW PITCH POINTER.
07100	
07200		X=RH(K,J2)
07300	C  GET FIRST OF NEW STRING.
07400	
07500		IF(XDUR.GT.P(1))GO TO 2
07600	C  CHECK ON ORIGINAL DURATION.
07700	
07800		DUR(INUM)=0
07900	C  IF WE'VE PASSED ORIGINAL DUR. CAUSE ENDING NOW.
08000		X=-1
08100	C  LAST 'NOTE' IS A REST.
08200	
08300	2	P(2)=X
08400	C  PUT RHYTH. INTO P2
08500	
08600		P(3)=J3+K
08700	C  PUT NOTE NUM INTO P3
08800	
08900		RETURN 
09000		END
09100	
09200	
09300	C  TYPICAL INPUT
09400	
09500	C CLAR 0 25;
09600	C P2  1  1,5.999; <POINTERS TO RHYTH. GROUPS
09700	C P3  1  C3,C5; 
09800	C P4 2000; P5 F1;  P7 F4;
09900	C P11 RHY/8/4/8/.1; < .1 MAKES END MARK
10000	C P12 RHY/ 12X6/ 20X5/ 4/ .1;
10100	C P13 RHY/ 4./ 16// 8// .1;
10200	C P14 RHY/ 4/ 16/ 8X4/ 16/ 4/ .1;
10300	C P15 SUBN RHY/ 16/ -8./ 16/ -16/ REP 2 / .1;
10400	C END;
10500	C TEMPO/120;